home *** CD-ROM | disk | FTP | other *** search
/ Gekkan Dennou Club 140 / Gekkan Dennou Club - 2000.1 Vol. 140 (Japan) (Track 1).bin / docs / perl / keiro3.pl < prev    next >
Encoding:
Text File  |  1999-10-29  |  1.3 KB  |  58 lines
  1. #
  2. # keiro11.pl : 幅優先探索
  3. #
  4. #　　Ｈ───Ｉ───Ｊ───Ｋ
  5. #　　│　　　│　　／│
  6. #　　│　　　│　／　│
  7. #　　│　　　│／　　│
  8. #　　Ｅ───Ｆ───Ｇ
  9. #　　│　　／│　　　│
  10. #　　│　／　│　　　│
  11. #　　│／　　│　　　│
  12. #　　Ａ───Ｂ───Ｃ───Ｄ
  13. #
  14.  
  15. # 隣接リスト
  16. %adjacent = (
  17.   'A' => ['B', 'E', 'F'],
  18.   'B' => ['A', 'C', 'F'],
  19.   'C' => ['B', 'D', 'G'],
  20.   'D' => ['C'],
  21.   'E' => ['A', 'F', 'H'],
  22.   'F' => ['A', 'B', 'E', 'G', 'I', 'J'],
  23.   'G' => ['C', 'F', 'J'],
  24.   'H' => ['E', 'I'],
  25.   'I' => ['F', 'H', 'J'],
  26.   'J' => ['G', 'I', 'K'],
  27.   'K' => ['J']
  28. );
  29.  
  30. # 探索
  31. sub search {
  32.   my ($start, $end) = @_;
  33.   my @queue = ();            # 経路を格納するキュー
  34.   push( @queue, [$start] );  # スタート地点をセット
  35.   while( @queue > 0 ){
  36.     my $path = shift( @queue );      # 経路を取り出す
  37.     my $postion = $path->[$#$path];   # 最後の頂点を取り出す
  38.     foreach $next ( @{ $adjacent{$postion} } ){
  39.       # $next が経路に含まれていないことを確認
  40.       if( !grep( /$next/, @$path ) ){
  41.         my $new_path = [ @$path ];     # 経路をコピー
  42.         push( @$new_path, $next );
  43.         if( $next eq $end ){
  44.           print "@$new_path\n";
  45.         } else {
  46.           push( @queue, $new_path );   # キューに追加
  47.         }
  48.       }
  49.     }
  50.   }
  51. }
  52.  
  53. # 実行
  54. &search( 'A', 'K' );
  55.  
  56. # end of file
  57.  
  58.